## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Loading required package: DoE.base
## Loading required package: grid
## Loading required package: conf.design
## Registered S3 method overwritten by 'DoE.base':
##   method           from       
##   factorize.factor conf.design
## 
## Attaching package: 'DoE.base'
## The following objects are masked from 'package:stats':
## 
##     aov, lm
## The following object is masked from 'package:graphics':
## 
##     plot.design
## The following object is masked from 'package:base':
## 
##     lengths
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0     ✔ purrr   1.0.1
## ✔ tibble  3.1.8     ✔ stringr 1.5.0
## ✔ tidyr   1.3.0     ✔ forcats 1.0.0
## ✔ readr   2.1.3     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ tidyr::extract()   masks magrittr::extract()
## ✖ dplyr::filter()    masks stats::filter()
## ✖ dplyr::lag()       masks stats::lag()
## ✖ purrr::set_names() masks magrittr::set_names()
## 
## Attaching package: 'MASS'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     select
## 
## 
## Package 'mclust' version 6.0.0
## Type 'citation("mclust")' for citing this R package in publications.
## 
## 
## Attaching package: 'mclust'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     map
## 
## 
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
## 
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
## 
## Loading required package: data.table
## 
## 
## Attaching package: 'data.table'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     transpose
## 
## 
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last

Análisis de las variables

Se tienen 6 variables

Edad <- Variable categórica

Causa.De.Muerte <- Variable cualitativa

Total <- Variable cuantitativa

Hombres <- Variable cuantitativa

Mujeres <- Variable cuantitativa

año_info <- Variable categórica

summary(datos)
##      Edad           Causa.de.muerte        Total            Hombres     
##  Length:5316        Length:5316        Min.   :    1.0   Min.   :    0  
##  Class :character   Class :character   1st Qu.:   33.0   1st Qu.:   19  
##  Mode  :character   Mode  :character   Median :   89.0   Median :   53  
##                                        Mean   :  644.6   Mean   :  363  
##                                        3rd Qu.:  225.0   3rd Qu.:  136  
##                                        Max.   :85600.0   Max.   :47002  
##     Mujeres           año_info   
##  Min.   :    0.0   Min.   :2009  
##  1st Qu.:    9.0   1st Qu.:2011  
##  Median :   31.0   Median :2014  
##  Mean   :  281.6   Mean   :2014  
##  3rd Qu.:   94.0   3rd Qu.:2017  
##  Max.   :38598.0   Max.   :2019
str(datos)
## 'data.frame':    5316 obs. of  6 variables:
##  $ Edad           : chr  "Todas las edades" "Todas las edades" "Todas las edades" "Todas las edades" ...
##  $ Causa.de.muerte: chr  "Todas las causas" "Neumonía, organismo no especificado" "Agresión con disparo de otras armas de fuego, y las no especificadas" "Exposición a factores no especificados" ...
##  $ Total          : int  71707 7013 5000 3693 3410 2997 2502 2031 1738 1720 ...
##  $ Hombres        : int  41354 3770 4512 3077 1843 1275 1340 931 1162 846 ...
##  $ Mujeres        : int  30353 3243 488 616 1567 1722 1162 1100 576 874 ...
##  $ año_info       : int  2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 ...

Ahora, se procede a observar si las variables cuantitativas respetan una distribución normal.

Total

library(nortest)
hist(datos$Total)

qqnorm(datos$Total)
qqline(datos$Total)

lillie.test(datos$Total)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos$Total
## D = 0.43555, p-value < 2.2e-16

Basándose en la gráfica, donde se puede notar que los puntos se alejan de la recta teórica, podemos argumentar que los datos no respetan una distribución normal, lo cuál se confirma en el test Lillie, donde se rechaza la hipótesis nula, por lo tanto, se concluye que los datos no provienen de una distribución normal.

Hombres

hist(datos$Hombres)

qqnorm(datos$Hombres)
qqline(datos$Hombres)

lillie.test(datos$Hombres)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos$Hombres
## D = 0.43518, p-value < 2.2e-16

Al igual que con los datos Totales, las muertes de los hombres no respetan una distribución normal.

Mujeres

hist(datos$Mujeres)

qqnorm(datos$Mujeres)
qqline(datos$Mujeres)

lillie.test(datos$Mujeres)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos$Mujeres
## D = 0.43604, p-value < 2.2e-16

Al igual que con los datos Totales, las muertes de los hombres no respetan una distribución normal.

Ahora, se crean bases de datos agrupadas por causas de muerte y por año

datos_causa <- datos %>% group_by(Causa.de.muerte) %>% summarize(HombresTot = sum(Hombres), MujeresTot = sum(Mujeres), Tot = sum(Total))

datos_anual <- datos %>% group_by(año_info) %>% summarize(HombresTot = sum(Hombres), MujeresTot = sum(Mujeres), Tot = sum(Total))

Se realiza el análisis de distribución a las mismas variables con las nuevas bases de datos:

Causa

Hombres

hist(datos_causa$HombresTot)

qqnorm(datos_causa$HombresTot)
qqline(datos_causa$HombresTot)

lillie.test(datos_causa$HombresTot)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos_causa$HombresTot
## D = 0.43544, p-value < 2.2e-16

Se revela con el test y con las gráficas que las muertes de los hombres no respetan una distribución normal si se agrupan por causa.

Mujeres

hist(datos_causa$MujeresTot)

qqnorm(datos_causa$MujeresTot)
qqline(datos_causa$MujeresTot)

lillie.test(datos_causa$MujeresTot)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos_causa$MujeresTot
## D = 0.4361, p-value < 2.2e-16

Se revela con el test y con las gráficas que los decesis de las mujeres no respetan una distribución normal si se agrupan por causa.

Total

hist(datos_causa$Tot)

qqnorm(datos_causa$Tot)
qqline(datos_causa$Tot)

lillie.test(datos_causa$Tot)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos_causa$Tot
## D = 0.43569, p-value < 2.2e-16

Al igual que con los datos pasados el total de decesos no respeta una distribución normal si son agrupadas por causa.

Año

Hombres

hist(datos_anual$HombresTot)

qqnorm(datos_anual$HombresTot)
qqline(datos_anual$HombresTot)

lillie.test(datos_anual$HombresTot)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos_anual$HombresTot
## D = 0.2257, p-value = 0.1213

Ya que el valor-p en el test de Lillie es mayor a 0.05 no se puede concluir que los decesos de los hombres no respetan una distribución normal si se agrupan por año.

Mujeres

hist(datos_anual$MujeresTot)

qqnorm(datos_anual$MujeresTot)
qqline(datos_anual$MujeresTot)

lillie.test(datos_anual$MujeresTot)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos_anual$MujeresTot
## D = 0.16551, p-value = 0.5454

Al igual que con los decesos de los hombres, no se puede concluir que las muertes de las mujeres no respetan una distribución normal.

Total

hist(datos_anual$Tot)

qqnorm(datos_anual$Tot)
qqline(datos_anual$Tot)

lillie.test(datos_anual$Tot)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  datos_anual$Tot
## D = 0.20732, p-value = 0.2065

Con un valor-p mayor a 0.05 no se puede concluir que el Total de decesos no se ajusta a una distribución normal si se agrupan por año.

Algunas preguntas interesantes que pueden surgir son:

  • ¿Cuál es la causa de muerte más común en el dataset?

  • ¿Cómo ha cambiado la tasa de mortalidad a lo largo de los años en el dataset?

  • ¿Existen patrones estacionales en las causas de muerte?

Discutiendo se pudo llegar a la siguiente incognita en específico la cual es nuestro tema de investigación para esta base de datos.

Evolucionón de las causas de muerte en Guatemala durante el periodo de 2009 - 2019

Para poder responder la pregunta primero debemos de realizar gráficos del comportamiento de cada causa de muerte en cada año.

library(dplyr)

datos_filtrados <- datos %>%
  group_by(año_info, Causa.de.muerte) %>%
  filter(n() == max(n())) %>%
  ungroup()

tabla_frecuencia <- table(datos_filtrados$Causa.de.muerte, datos_filtrados$año_info)
tabla_frecuencia <- as.data.frame(tabla_frecuencia)


library(knitr)
#kable(tabla_frecuencia, caption = "Tabla de frecuencia de Causa de muerte y años")

Ahora graficamos la tabla por cada causa de muerte:

# Ciclo para crear un histograma por cada causa de muerte
for (i in unique(tabla_frecuencia$Var1)) {
  
  # Filtrar los datos por causa de muerte
  datos_causa_muerte <- filter(tabla_frecuencia, Var1 == i)
  
  # Crear el gráfico de histograma
  grafico <- ggplot(data = datos_causa_muerte, aes(x = Var2, y = Freq)) +
    geom_bar(stat = "identity", fill = "blue") +
    ggtitle(paste0("Frecuencia de ", i, " por año")) +
    xlab("Año") + ylab("Frecuencia") +
    theme(plot.title = element_text(size = 20, face = "bold"),
          axis.title.x = element_text(size = 16),
          axis.title.y = element_text(size = 16),
          axis.text.x = element_text(size = 14),
          axis.text.y = element_text(size = 14))
  
  # Imprimir el gráfico
  print(grafico)
}

# Cargamos las librerías dplyr y tidyr
library(dplyr)
library(tidyr)

# Filtramos la tabla para excluir los valores de Var1 que se llamen "Todas las causas" y "Otras causas"
tabla_filtrada <- tabla_frecuencia %>% filter(Var1 != "Todas las causas" & Var1 != "Otras causas" & Var1 != "Síntomas, signos y hallazgos anormales clínicos y de laboratorio, no clasificados en otra parte" )

# Agrupamos la tabla por año y calculamos la causa de muerte con mayor frecuencia para cada año
tabla_resumen <- tabla_filtrada %>% 
  group_by(Var2) %>% 
  summarise(principal_causa = Var1[which.max(Freq)])

# Generamos la nueva tabla con la forma solicitada
tabla_final <- data.frame(Año = tabla_resumen$Var2, `Principal Causa de Muerte` = tabla_resumen$principal_causa)

tabla_final
##     Año           Principal.Causa.de.Muerte
## 1  2009 Neumonía, organismo no especificado
## 2  2010 Neumonía, organismo no especificado
## 3  2011 Neumonía, organismo no especificado
## 4  2012 Neumonía, organismo no especificado
## 5  2013 Neumonía, organismo no especificado
## 6  2014 Neumonía, organismo no especificado
## 7  2015 Neumonía, organismo no especificado
## 8  2016 Neumonía, organismo no especificado
## 9  2017 Neumonía, organismo no especificado
## 10 2018 Neumonía, organismo no especificado
## 11 2019 Neumonía, organismo no especificado

Los resultados alojan información valiosa de las variables:

  • Causa de Muerte
  • Año de Muerte

Podemos observar que estas variables nos pueden ayudar para resolver el la problemática planteada.

Podemos observar en las gráficas anteriores que hay causas de muerte en las cuales su frecuencia de ocurrecia es en un año en particular, y muchos de estos son frecuencias de baja incidencia, tal sería el caso por ejemplo de la muerte causada por afecciones respiratorias(gráfica 3), que tuvo una ocurrencia en el año 2015, también el de ahorcamientos o estrangulamientos(gráfica 10) con una ocurrencia de un evento por año en los años 2009 y 2010, la frecuencia de muerte por amiloidosis(gráfica 11) de 3 veces en el año 2015, la frecuencia de apendicitis aguda(gráfica 13) en el año 2017, la frecuencia de muerte por Ascariasis(gráfica 14) de 1 vez en el año 2012 y asi entre muchas, de las cuales 31 de todas las causas tienen incidencia en 2 o menos años.

Principales causas de muerte por año

##Clustering Para poder hacer un clustering efectivo debemos de tener todas nuestras variables de forma numerica y normalizadas.

##primero debemos de volver numericas nuestras variables y finalmente escalarlas

Causa.de.muerte <- as.numeric(tabla_frecuencia[,"Var1"])
Total <- as.numeric(tabla_frecuencia[,"Freq"])
año_info <- as.numeric(tabla_frecuencia[,"Var2"])

datosc <- data.frame(Causa.de.muerte,año_info,Total)

#Escalar los datos
datosCS <- scale(na.omit(datosc))

Luego de la normalizacion de los datos obtenemos un estadistico de Hopkins para determinar el agrupamiento puede ser factible.

##Estadistico de hopkins

hopkins(datosCS)
## [1] 0.971783
datos_dist<- dist(datosCS)

El valor del estadístico de hopkins está alejado de 0.5 por lo que los datos no son aleatorios hay altas posibilidades de que sea factible el agrupamiento.

#Matriz de distancia
datos_dist<- dist(datosCS)
fviz_dist(datos_dist, show_labels = F)

Como se puede observar en la VAT sí se observan ciertos patrones por lo que se ratifica lo que arroja el estadístico de hopkings.

Al determinar que si es posible realizar un agrupamiento, determinamos de dos maneras cuantas agripaciones debeiamos de utilizar.

####Cantidad de grupo que debemos de hacer

fviz_nbclust(datosCS, kmeans, method = "wss") +
labs(subtitle = "Metodo del codo")

fviz_nbclust(datosCS, kmeans, method = "silhouette") +
labs(subtitle = "Método de la silueta")

Luego de analizar los algoritmos se determinó que el numero de agrupaciones debía de ser de 5, ya que segun el método del codo y el método del a silueta, esta cantidad es la más óptima. Luego de este análisis procedemos a agrupar por medio de K-medias

Agrupamos por medio de 2 distintos tipos algoritmos de agrupación:

K-Medias

km<-kmeans(datosCS,5,iter.max =100)
plotcluster(datosCS,km$cluster)

Como se observa en la imagen, el primer paso es escoger el numero de grupos K, en este caso fue 5 tal como se justificó anteriormente, posterior a ello se establecen k centroides en el espacio de datos.

fviz_cluster(km, data = datosCS,geom = "point", ellipse.type = "norm")

silkm<-silhouette(km$cluster,dist(datosCS))
mean(silkm[,3]) 
## [1] 0.3386924
Kmean<-mean(silkm[,3])

A partir de los 2 gráficos anteriores, podemos observar que los datos separados en 5 grupos se presentan juntos entre si, podemos observar que la intersección entre cada uno de los 5 grupos es mínima, lo cual puede ser un buen indicador para nuestro agrupamiento. Esto puede ser evaluado de mejor manera a traves de un Cluster jerárquico.

Cluster jerárquico

matriz_dist<- dist(datosCS)
hc<-hclust(datos_dist, method = "ward.D2") #Genera el clustering jerarquico de los datos
plot(hc, cex=0.5, axes=FALSE) #Genera el dendograma
#cutree(hc, h = 5)
rect.hclust(hc,k=5)

groups<-cutree(hc,k=5) #corta el dendograma, determinando el grupo de cada fila
datosc$gruposHC<-groups
silhc<-silhouette(groups,datos_dist)
mean(silhc[,3]) 
## [1] 0.2821096
Jerarquico<-mean(silhc[,3])

Como se observa la silueta del algoritmo cluster jerárquico fue de 0.2821096, indicando que la agrupación no es la mejor.

Es importante analizar el tamaño resultante de cada grupo, los cuales se presentan en la siguiente tabla

table(groups)
## groups
##   1   2   3   4   5 
## 303 318  69 489 284

Como podemos observar 3 de los 5 grupos resultaron balanceados, y de los otros 2, uno resultó con un tamaño mucho menor que lo esperado y otro mucho mayor de lo esperado. Seguiremos analizando las medias de la variable años en cada grupo. Se analiza solo esta variable ya que no tiene sentido evaluar la media a una variable no numerica como es la causa, ya que no presenta un orden.

by(datosc[,2:3],datosc[,"gruposHC"], colMeans)
## datosc[, "gruposHC"]: 1
## año_info    Total 
## 4.036304 1.283828 
## ------------------------------------------------------------ 
## datosc[, "gruposHC"]: 2
## año_info    Total 
## 8.050314 5.503145 
## ------------------------------------------------------------ 
## datosc[, "gruposHC"]: 3
##  año_info     Total 
##  5.884058 24.855072 
## ------------------------------------------------------------ 
## datosc[, "gruposHC"]: 4
## año_info    Total 
## 3.862986 1.803681 
## ------------------------------------------------------------ 
## datosc[, "gruposHC"]: 5
## año_info    Total 
## 9.507042 2.042254

Como podemos observar en los resultados anteriores, en el grupo 1 se tiene una media en para años de aproximadamente 4, que es el numero asignado para el año 2012, para el grupo 2 resultó que la media de las muertes resultan en el año 2016, para el grupo 3 resulto una media alrededor del año 2013, para el grupo 4 al igual que el grupo 1 resulto que la media de muertes sucedio de igual manera en el año 2012 y atípicamente en el grupo 5 resulto una muerte media en el año 2017. Por otro lado, la media de la cantidad de muertes por causa resultó de 1.28 para el grupo 1, una media de 5.5 muertes por caso en el grupo 2, una media de 24.86 muertes por caso en el grupo 3, una media de 1.8 muertes por caso en el grupo 4 y una media de 2.04 muertes por causa en el grupo 5.

A continuación se presenta un dendograma visualizado de forma horizontal para poder diferenciar los grupos. Podemos observar de forma visual que el grupo de color aqua(grupo entre el color azul y verde) es bastante pequeño, resulta dificil de identificar, ya que a su lado el grupo de color verde, es el que tiene mayor tamaño.

fviz_dend(hc,k=5, cex = .2, horiz = T)
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
##   Please report the issue at <]8;;https://github.com/kassambara/factoextra/issueshttps://github.com/kassambara/factoextra/issues]8;;>.

El gráfico de la silueta de K-means sería el siguiente:

plot(silkm, cex.names=.4, col=1:4, border=NA)

Y el gráfico de la silueta de Jerargico sería:

plot(silhc, cex.names=.4, col=1:4, border = NA)

Al recopilar el promedio de los datos obtenemos:

df <- data.frame(Algoritmo=c("K-mean", "Jerarquico"),
                Silueta=c(Kmean, Jerarquico))
df
##    Algoritmo   Silueta
## 1     K-mean 0.3386924
## 2 Jerarquico 0.2821096

Se puede observar que el cluster jerárquico fue el que obtuvo el mejor resultado en la prueba de silueta pero que el algorito Kmeans es mayor que el Jerarguico por 0.5 puntos. Al observar los valores de las siluetas observamos que no es la mejor agrupacion pero que no es mala de igua forma. Tambien observamos que en los grupos de ambas siluetas hay elementos mal ubicados ya que hay valores negativos dentro de las siluetas.

```